home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0009_Saving the EGA-VGA Font.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  1.8 KB  |  69 lines
  1. USES Graph;
  2.  
  3. TYPE
  4.  
  5.    TByteArray = Array [0..16384] Of Byte;
  6.    PByteArray = ^TByteArray;
  7.  
  8. VAR I, J: Integer; BiosFont: PByteArray; F: Text;
  9.  
  10. PROCEDURE GetBiosFont; ASSEMBLER;
  11. ASM
  12.    PUSH BP;
  13.    PUSH DS;
  14.    MOV AX, 1130H;
  15.    MOV BX, 0100H;
  16.    INT 10H;
  17.    MOV BX, BP;
  18.    POP DS;
  19.    POP BP;
  20.    MOV WORD PTR [BiosFont], BX;
  21.    MOV WORD PTR [BiosFont+2], ES;
  22. END;
  23.  
  24. FUNCTION Hex (Num: Word; Nib: Byte): String; ASSEMBLER;
  25. ASM
  26.    LES DI, @Result;                                   { ES:DI -> return }
  27.    XOR CH, CH;
  28.    MOV CL, Nib;                                       { String length }
  29.    MOV ES:[DI], CL;
  30.    JCXZ @@3;                                          { Check for zero }
  31.    ADD DI, CX;
  32.    MOV BX, Num;
  33.    STD;                                               { Strings backwards }
  34. @@1:
  35.    MOV AL, BL;                                        { Current nibble }
  36.    AND AL, $0F;
  37.    OR AL, $30 ;                                       { Convert to ascii }
  38.    CMP AL, $3A;
  39.    JB @@2;                                            { Contains A-F patch }
  40.    ADD  AL, $07;
  41. @@2:
  42.    STOSB;                                             { Store the byte }
  43.    SHR BX, 1;
  44.    SHR BX, 1;
  45.    SHR BX, 1;                                         { Roll of nible done }
  46.    SHR BX, 1;
  47.    LOOP @@1;
  48. @@3:
  49.    CLD;                                               { Reset direction }
  50. END;
  51.  
  52.     BEGIN
  53.        InitGraph(I, J, '');
  54.        GetBiosFont;
  55.        Assign(F, 'BiosFont.Bin');
  56.        Rewrite(F);
  57.        WriteLn(F, 'BiosFont: Array [0..4096] Of Byte = (');
  58.        For J := 0 To 255 Do Begin
  59.          For I := 0 To 15 Do Begin
  60.             Write(F, '$', Hex(BiosFont^[J*16+I], 2), ',');
  61.          End;
  62.          WriteLn(F);
  63.        End;
  64.        WriteLn(F, '0);');
  65.        Close(F);
  66.        CloseGraph;
  67.     END.
  68.  
  69.